-- CIS 552, Mini-project
-- by Mike Gottlieb and Reilly Grant

-- |Representation and functions on playing cards.
module Card (T, Rank, Suit(..), -- types
             card, suit, rank, rankName, -- accessors
             valid, parse, justParse, showCard, -- functions
             test -- tests
            ) where

import Util
import Test.QuickCheck hiding (test)

data T = Card Suit Rank

type Rank = Integer -- Rank is one of [2..14] 14 being Ace
data Suit = Heart | Club | Diamond | Spade -- Suit is one of these
            deriving (Show, Enum, Eq, Bounded)

instance Eq T where -- compares suit and rank for equality
    (==) (Card s1 r1) (Card s2 r2) = (s1 == s2) && (r1 == r2)

instance Ord T where -- cards only ordered by rank
    compare (Card _ r1) (Card _ r2) = compare r1 r2

-- This is the longer, more readable show
instance Show T where 
    show (Card s r) = let first = case r of 14 -> "Ace"
                                            13 -> "King"
                                            12 -> "Queen"
                                            11 -> "Jack"
                                            _  -> show r
                          second = show s in
                          first ++ " of " ++ second ++ "s"


-- This is the shorter card print for brevity and reference
showCard :: T -> String
showCard (Card suit rank) = (rankName rank) ++ (shortSuit suit)
                     

-- |Exported function to construct a card.
card :: Suit -> Rank -> T
card = Card

-- |Gets the suit out of a Card.
suit :: T -> Suit 
suit (Card s r) = s

-- |Gets the rank out of a Card.
rank :: T -> Rank 
rank (Card s r) = r

-- |Tests if the rank of a card is valid, suit is by definition valid.
valid :: T -> Bool 
valid (Card s r) = (r > 1) && (r < 15)

-- |String representations of suits.
shortSuit :: Suit -> String 
shortSuit s = case s of Heart   -> "H"
                        Club    -> "C"
                        Diamond -> "D"
                        Spade   -> "S"

-- |String representations of ranks.
rankName :: Rank -> String 
rankName r = case r of 11 -> "J"
                       12 -> "Q"
                       13 -> "K"
                       14 -> "A"
                       n  -> show n

-- |Parse the short representation of a card into the card type.
parse :: String -> Maybe T
parse s = do suit <- parseSuit (last s)
             rank <- parseRank (init s)
             let c = card suit rank
             if valid c then Just c
                        else Nothing

-- |Parse the short representation of a card into the card type.
-- Assumes input is well-formed.
justParse :: String -> T
justParse s = case parse s of Just c  -> c
                              Nothing -> error $ "Parse failed: " ++ s

-- |Special cases for Jack, Queen, King, Ace.
parseRank :: String -> Maybe Rank
parseRank s = case s of "A" -> Just 14
                        "J" -> Just 11
                        "Q" -> Just 12
                        "K" -> Just 13
                        n   -> readMaybe n

-- |Parse the short reprentations of suits.
parseSuit :: Char -> Maybe Suit
parseSuit c = case c of 'H' -> Just Heart
                        'C' -> Just Club
                        'D' -> Just Diamond
                        'S' -> Just Spade
                        _   -> Nothing

------------------------------------------------------------
-- Testing
------------------------------------------------------------

-- Used to generate randoms suits for tests.
instance Arbitrary Suit where
    arbitrary = oneof $ map return [Heart, Club, Diamond, Spade]
    coarbitrary s = case s of Heart -> variant 0
                              Club -> variant 1
                              Diamond -> variant 2
                              Spade -> variant 3

prop_legalCard s r =
    ((r > 1) && (r < 15)) == (valid (card s r))
    -- The type system won't let s be anything other than one of the type
    -- constructors for Suit, and therefore a valid value.

invalidCard :: T
invalidCard = card Heart (-1)

-- |Test constructing a card from parsing a its representation.
prop_parseCard s r =
    valid c ==> maybe invalidCard id (parse (show c)) == c
    where c = card s r

-- |Run all card test cases.
test = do quickCheck prop_legalCard
          quickCheck prop_parseCard
